home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / biorhyth.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-04-04  |  2.0 KB  |  93 lines
  1. 10  ' ************
  2. 20  ' * BIORHYTH *
  3. 30  ' ************
  4. 100  REM: DISPLAY BIORHYTHM CHARTS
  5. 120  REM: IBM BASIC 80 COLUMN CRT
  6. 140  DEFINT K,L:DEFDBL B,J,M-Z
  7. 150  L=0:Z=0.99999:T=33:P=3.14159:I=1
  8. 160  KEY OFF:SCREEN 0,0:WIDTH 80:COLOR 7,0:CLS
  9. 170  PRINT TAB(8);"BIORHYTHM"
  10. 180  GOSUB 1000:PRINT:PRINT
  11. 190  PRINT"ENTER BIRTH DATE"
  12. 200  GOSUB 450
  13. 210  GOSUB 550
  14. 220  JB=JD
  15. 230  PRINT:PRINT"ENTER START DATE FOR CHART"
  16. 240  GOSUB 450
  17. 250  GOSUB 550
  18. 260  JC=JD
  19. 270  IF JC>=JB THEN 310
  20. 280  PRINT"CHART DATE CAN'T BE EARLIER"
  21. 290  PRINT"THAN BIRTH DATE.  TRY AGAIN."
  22. 300  GOTO 180
  23. 310  FOR K=1 TO 1000:NEXT
  24. 320  GOSUB 630
  25. 330  N=JC-JB
  26. 340  V=23:GOSUB 690
  27. 350  V=28:GOSUB 690
  28. 360  V=33:GOSUB 690
  29. 370  GOSUB 850
  30. 380  PRINT TAB(1);C$;TAB(9);L$
  31. 390  JC=JC+1:L=L+1:IF L<18 THEN 330
  32. 400  PRINT:PRINT"PRESS Esc TO END PGM, 'E' TO END CHART, SPACE TO CONTINUE";
  33. 410  R$=INKEY$:IF LEN(R$)=0 THEN 410
  34. 420  IF ASC(R$)=27 THEN END
  35. 430  IF R$="E" OR R$="e" THEN 150
  36. 440  L=0:GOTO 320
  37. 450  PRINT
  38. 460  INPUT "MONTH (1 TO 12)";M
  39. 470  M=INT(M):IF M<1 OR M>12 THEN BEEP:GOTO 460
  40. 480  INPUT "DAY (1 TO 31)";D
  41. 490  D=INT(D):IF D<1 OR D>31 THEN BEEP:GOTO 480
  42. 500  INPUT "YEAR";Y
  43. 510  Y=INT(Y):IF Y<0 THEN 500
  44. 520  IF Y>99 THEN 540
  45. 530  Y=Y+1900:PRINT Y;"ASSUMED."
  46. 540  RETURN
  47. 550  W=INT((M-14)/12+Z)
  48. 560  JD=INT(1461*(Y+4800+W)/4)
  49. 570  B=367*(M-2-W*12)/12
  50. 580  IF B<0 THEN B=B+Z
  51. 590  B=INT(B):JD=JD+B
  52. 600  B=INT(INT(3*(Y+4900+W)/100)/4)
  53. 610  JD=JD+D-32075-B
  54. 620  RETURN
  55. 630  CLS
  56. 640  PRINT TAB(T+5);"BIORHYTHM"
  57. 650  PRINT TAB(1);"--DATE--";TAB(5+INT(T/2));
  58. 660  PRINT "D O W N";TAB(9+T);"0";TAB(8+INT(1.5*T));"U P"
  59. 670  PRINT TAB(9);U$
  60. 680  RETURN
  61. 690  W=INT(N/V):R=N-W*V
  62. 700  IF V<>23 THEN 730
  63. 710  L$=STRING$(T,32)+CHR$(176)+STRING$(T,32)
  64. 720  IF V=23 THEN C$="P"
  65. 730  IF V=28 THEN C$="E"
  66. 740  IF V=33 THEN C$="I"
  67. 750  W=R/V:W=W*2*P
  68. 760  W=T*SIN(W):W=W+T+1.5
  69. 770  W=INT(W):A$=MID$(L$,W,1)
  70. 780  IF A$="P" OR A$="E" OR A$="*" THEN C$="*"
  71. 790  IF W=1 THEN 830
  72. 800  IF W=T+T+1 THEN 840
  73. 810  L$=LEFT$(L$,W-1)+C$+RIGHT$(L$,T+T+1-W)
  74. 820  RETURN
  75. 830  L$=C$+RIGHT$(L$,T+T):RETURN
  76. 840  L$=LEFT$(L$,T+T)+C$:RETURN
  77. 850  W=JC+68569:R=INT(4*W/146097)
  78. 860  W=W-INT((146097*R+3)/4)
  79. 870  Y=INT(4000*(W+1)/1.461E+06)
  80. 880  W=W-INT(1461*Y/4)+31
  81. 890  M=INT(80*W/2447)
  82. 900  D=W-INT(2447*M/80)
  83. 910  W=INT(M/11):M=M+2-12*W
  84. 920  Y=100*(R-49)+Y+W
  85. 930  A$=STR$(M):W=LEN(A$)-1
  86. 940  C$=MID$(A$,2,W)+"/"
  87. 950  A$=STR$(D):W=LEN(A$)-1
  88. 960  C$=C$+MID$(A$,2,W)+"/"
  89. 970  A$=STR$(Y):W=LEN(A$)-1
  90. 980  C$=C$+MID$(A$,W,2)
  91. 990  RETURN
  92. 1000  U$=STRING$((T+T+1),176):RETURN
  93.